#define USE_RINTERNALS
#include <Rinternals.h>
#include <R.h>
#include <Rversion.h>
#include "../../lib/bc.h"
#include "../../lib/config.h"

#define BC_MIN_VERSION 6
#define BC_MAX_VERSION 7

#if R_VERSION > 134401
# define RIDENTICAL(__x__,__y__) R_compute_identical(__x__,__y__, 1)
#else
# define RIDENTICAL(__x__,__y__) R_compute_identical(__x__,__y__, 1, 1, 1)
#endif

#define __CACHE_SUBSYSTEM
#ifdef R_DEBUG
#	define dprintf(...) Rprintf(__VA_ARGS__);
#else
#	define dprintf(...)
#endif

#define MAX_SEGMENT_SIZE 0x8ffff
#define MAX_CPOOL 0x8ffff

typedef struct { SEXP code; int lbl; int *addr; } relocatable_segment ; // for now, each prom is a new subroutine

struct relocatable_list { struct relocatable_list *next; relocatable_segment item ; };
static struct relocatable_list funs;
static struct relocatable_list promises;
static struct relocatable_list *tail_funs; // shared for everybody

struct fun_info_list { struct fun_info_list *next; fun_info item ; };
static struct fun_info_list info_list, *tail_info;

static cpool_entry cpool[MAX_CPOOL];  // The singleton Constant Pool

// The shared heap/pointer (must be hidded but for now it's enought)
static int pc;
//static int param_names_pe;
//static int param_values_pe;
static int cs[MAX_SEGMENT_SIZE]; // will be a unsigned char soon

static int putInPool(SEXP);
static int isCodeBuffer(SEXP);
static int relocateMainCode(SEXP);
static int relocateFunctionCode(SEXP);
static int relocatePromises(struct relocatable_list *head_prom, struct relocatable_list *tail_prom);
static int relocateBC(SEXP, struct relocatable_list **current, int not_promise, int is_main);
static int relocateArgs(int bc, int *pc, int bp, SEXP pool);


static int validBC(int);
static int isBC(SEXP);
static int write_file(const char *fname);

static void dumpCachePool();

static void dumpCode(SEXP);
static void dumpBCObj(SEXP);

static bc_header header = {BC_MAGIC};

static int getPC(){ return pc; }
static int putInCode(int bc){
	if(pc == MAX_SEGMENT_SIZE)
		error("Code exced segment size: %d", MAX_SEGMENT_SIZE);
	cs[pc] = bc;
	return pc ++;
}
static int putInCodeVerbose(int bc){
  Rprintf("%d\n", bc);
  putInCode(bc);
}
static void validateCS(){
}

extern SEXP Rf_deparse1(SEXP, Rboolean, int);

static int nbArgs[] = { // R bytecode original map
	P0(), P0(), P1(LBL), P2(IDX, LBL), P0(), P0(), P0(), P1(IDX), P0(), P0(), // DOLOOPNEXT
	P0(), P3(IDX,IDX,LBL), P1(LBL), P0(), P0(), P0(), P1(IDX), P0(), P0(), P0(), // LDFALSE
	P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P0(), P1(IDX), // MKPROM
	P0(), P1(IDX), P0(), P0(), P1(IDX), P0(), P0(), P0(), P3(IDX, IDX, IMM), P3(IDX, IDX, IDX), // CallBuiltIn
	P2(IDX, IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), // SQRT
	P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), P1(IDX), // NOT
	P0(), P1(IDX), P1(IDX), P2(IDX, LBL), P0(), P2(IDX, LBL), P1(IDX), P2(IDX, LBL), P0(), P2(IDX, LBL), // STARTSUBSET2
	P0(), P2(IDX, LBL), P1(IDX), P1(IDX), P2(IDX, IDX), P0(), P0(), P0(), P0(), P0(), // ISCOMPLEX
	P0(), P0(), P0(), P0(), P0(), P0(), P0(), P0(), P2(IDX, LBL), P1(IDX), // AND2ND
	P2(IDX, LBL), P1(IDX), P1(IDX), P1(IDX), P0(), P1(IDX), P1(IDX), P1(IDX), P2(IDX, IDX), P1(IDX), // GETTERCALL
	P0(), P0(), P4(IDX, IDX, IOL, IOL), P0()
};


static struct relocatable_list *needRelocInstr(struct relocatable_list *list, SEXP code, int offset) {
	struct relocatable_list *new_item = (struct relocatable_list*)malloc(sizeof(struct relocatable_list));
	list->next = new_item;
	new_item->next = NULL;
	new_item->item.code = code;
	new_item->item.lbl = offset;
	new_item->item.addr = NULL;
	return new_item;
}

static struct relocatable_list *needRelocFunInfo(struct relocatable_list *list, SEXP code, int *addr_to_patch) {
	struct relocatable_list *new_item = (struct relocatable_list*)malloc(sizeof(struct relocatable_list));
	list->next = new_item;
	new_item->next = NULL;
	new_item->item.code = code;
	new_item->item.lbl = 0;
	new_item->item.addr = addr_to_patch;
	return new_item;
}

int addFunInfo(int start, int stop, int params){
  struct fun_info_list *new_item = (struct fun_info_list*)malloc(sizeof(struct fun_info_list));
  tail_info->next = new_item;
  new_item->next = NULL;
  new_item->item.start = start;
  new_item->item.end = stop;
  new_item->item.params = params;
  tail_info = new_item;
  return header.funinfos ++;
}

void allocate_fun_infos(fun_info **infos){
  int nb = 0;
  struct fun_info_list *ptr = &info_list;
  *infos = malloc(sizeof(fun_info) * nb);
  while((ptr = ptr->next) != NULL){
	(*infos)[nb].start = ptr->item.start;
	(*infos)[nb].end = ptr->item.end;
	(*infos)[nb].params = ptr->item.params;
	nb ++;
  }
}

static int nbpointerprotected; // For R protection stack (needed beacause of labels relocation, and cache)

#define INIT_LIST(__glob__, __tail__)\
  __tail__ = &__glob__;\
  __glob__.next = NULL

SEXP exportbc(SEXP file, SEXP code){
	header.pp = pc = nbpointerprotected = 0;
	header.funinfos = 0;

	struct relocatable_list *head_funs = &funs;
	INIT_LIST(funs, tail_funs);
	INIT_LIST(info_list, tail_info);

	dprintf("Starting bytecode relocation ...\n")
	relocateMainCode(code);
	head_funs = head_funs->next;
	while(head_funs){
		struct relocatable_list *current = head_funs;
		int relocatedAt = relocateFunctionCode(current->item.code);
		if(current->item.lbl){ // Ugly, need accessor to avoid direct cs modification
			*(cs + current->item.lbl) = relocatedAt;
		}else 
			*(current->item.addr) = relocatedAt;
		head_funs = head_funs->next;
		free(current);
	}

	header.cs = getPC();
#ifdef DEBUG_EXPORT_BC
	dumpBC(getPC()-1, (code_segment)cs, Rprintf);
	dumpCachePool();
#endif
	UNPROTECT(nbpointerprotected);

	SEXP rv = allocVector(INTSXP, 1);
	INTEGER(rv)[0] = write_file(CHAR(STRING_ELT(file, 0)));
	return rv;
}

int putInPoolVerbose(SEXP val);

static int write_file(const char *fname){
	FILE * fd = fopen(fname, "wb");
	if(!fd)
		error("Unable to create/open output file: %s", fname);
	fun_info *infos;
	allocate_fun_infos(&infos);
	write_bc_file(fd, &header, &cpool[0], &infos[0], &cs[0]);
	free(infos);
	fclose(fd);
	return 0;
}

static int relocateFunctionCode(SEXP code){
	struct relocatable_list *head_prom = &promises;
	INIT_LIST(promises, struct relocatable_list *tail_prom);

	if(!isCodeBuffer(code))
		error("Need a code buffer (%d) !", TYPEOF(code));

	dprintf("relocating function ...\n");
	SEXP params = VECTOR_ELT(code, 0);
	int len = length(params);
	//param_values_pe = 0;
	int param_pos;
	SEXP ptable_addr;
	//if(len > 0){
		ptable_addr = allocVector(INTSXP, len);
		PROTECT(ptable_addr);
		nbpointerprotected ++;
		SEXP ptable_names = allocVector(STRSXP, len);
		setAttrib(ptable_addr, R_NamesSymbol, ptable_names);
		for(int i = 0; params != R_NilValue; i++, params = CDR(params)){
			SEXP car = CAR(params);
			SET_STRING_ELT(ptable_names, i,  ((PRINTNAME(TAG(params)))));
			if(TYPEOF(car) == SYMSXP && car == R_MissingArg)
				INTEGER(ptable_addr)[i] = -1;
			else
				tail_prom = needRelocFunInfo(tail_prom, CAR(params), &INTEGER(ptable_addr)[i]);
		}
	//}
	int start_pos = getPC();
	relocateBC(VECTOR_ELT(code, 1), &tail_prom, 1, 0); // relocate the function code
	int end_pos = getPC() -1;
	relocatePromises(head_prom, tail_prom);
	return addFunInfo(start_pos, end_pos, putInPool(ptable_addr));
}

static int relocateMainCode(SEXP code){
	struct relocatable_list *head_prom = &promises;
	INIT_LIST(promises, struct relocatable_list *tail_prom);

	if(!isCodeBuffer(code))
		error("Need a code buffer (%d) !", TYPEOF(code));

	int start_pos = getPC();
	dprintf("relocating main code ...\n");
	for(int i = 0; i < length(code); i++)
		relocateBC(VECTOR_ELT(code,i), &tail_prom, (i != (length(code)-1)) + 1, 1); // relocate the main code
	if(cs[getPC() - 1 ] != BC_RETURN){ // FIXME this is ugly
	  dprintf("There was no return ... adding one !\n");
	  putInCode(BC_LDNULL);
	  putInCode(BC_RETURN);
	}

	int end_pos = getPC() - 1;
	relocatePromises(head_prom, tail_prom);
	return addFunInfo(start_pos, end_pos, -1);
}

static int relocatePromises(struct relocatable_list *head_prom, struct relocatable_list *tail_prom){
	dprintf("relocating promises (start at %d)...\n", getPC());
	head_prom = head_prom->next;
	while(head_prom){ // Now relocate promises
		struct relocatable_list *current = head_prom;
		int start_pos = getPC();
		relocateBC(current->item.code, &tail_prom, 0, 0); // Ugly, need accessor to avoid direct cs modification
		int fid = addFunInfo(start_pos, getPC() - 1, -1);
		if(current->item.lbl){
			Rprintf("Relocating by label is not valid for promises");
			exit(0);
		}else
			*(current->item.addr) = fid;
		head_prom = head_prom->next;
		free(current);
	}
	dprintf("function done (end at %d)\n", getPC());
	return -1;
}

static int relocateBC(SEXP code, struct relocatable_list **prom_list, int not_promise, int is_main){
	dprintf("\trelocating instruction ...");
	if(!isBC(code))
		error("Trying to relocate a non byteCode (%d) !", TYPEOF(code));
	SEXP ccode = CAR(code);
	int i = length(ccode) - 1;
	int *pc = INTEGER(ccode);
	SEXP pool = CDR(code);
	if((*pc < BC_MIN_VERSION) | (*pc > BC_MAX_VERSION))
		error("Bad bCode version ! Need version %d to %d, found version %d", BC_MIN_VERSION, BC_MAX_VERSION, *(pc));
	pc ++;
	int bp = getPC();
	int nb;

	// dumpBCObj(code);
	while(i --){
		int bc = *pc++;
		if(!validBC(bc))
			error("Invalid bCode: %d", bc);
		switch(bc){
			case BC_MKPROM: // MKPROMISE => Need to reloc add end of the function
				putInCode(bc);
				*prom_list = needRelocFunInfo(*prom_list, VECTOR_ELT(pool, *pc), cs+getPC());
				putInCode(*pc++);
				i--;
				break;
			case BC_MKCLOSURE: // MKCLOSURE => Need to reloc in its own segment
				putInCode(bc);
				tail_funs = needRelocInstr(tail_funs, VECTOR_ELT(pool, *pc), getPC());
				putInCode(*pc++);
				i--;
				break;
			case BC_RETURN:
				if(not_promise > 0 && !(is_main && (not_promise == 1))){
					if(not_promise == 2)
						putInCode(BC_PRINTVALUE);
					else
						putInCode(BC_RETURNJMP);
					break;
				}
				putInCode(bc);
				nb = relocateArgs(bc, pc, bp, pool);
				pc += nb; i -= nb;
				break;
			case BC_CALLSPECIAL:{
				putInCode(bc);
				putInCode(putInPool(VECTOR_ELT(pool, *pc ++))); // name of the builtin
				putInCode(INTEGER(VECTOR_ELT(pool, *pc++))[0]); // number of args
				i -= 2;
				}break;
			case BC_CALLBUILTIN:{
				putInCode(bc);
				putInCode(putInPool(VECTOR_ELT(pool, *pc ++))); // name of the builtin
				putInCode(putInPool(VECTOR_ELT(pool, *pc ++))); // text of args
				putInCode(INTEGER(VECTOR_ELT(pool, *pc++))[0]); // number of args
				i -= 3;
				}break;
			default: // All other case are standard relocation
				putInCode(bc);
				nb = relocateArgs(bc, pc, bp, pool);
				pc += nb; i -= nb;
		}
	}
	dprintf(" ok\n");
	// dumpCode(ccode);
	// Rprintf("\n");
	return bp;
}

static int relocateArgs(int bc, int *pc, int bp, SEXP pool){
	int args = nbArgs[bc];
	int nb = 0, len;
	SEXP lbls, nlbls; 
	while(args){
		switch(args & BCPMASK){
			case IMM:
				putInCode(*pc ++);
				break;
			case LBL:
				putInCode((*pc ++) + bp - 1); // Relocate labels
				break;
			case IDX:
				putInCode(putInPool(VECTOR_ELT(pool, *pc ++))); // Relocate a constant pool entry
				break;
			case IOL:
				lbls = VECTOR_ELT(pool, *pc++);
				if(TYPEOF(lbls) == NILSXP){ // This case is to handle the two semantics of the switch bcode !!!
					putInCode(putInPool(lbls)); // is supposed to be null
				} else if(TYPEOF(lbls) != INTSXP) {
					error("Trying to relocate a non label vector.");
				} else {
					len = length(lbls);
					SEXP nlbls = allocVector(INTSXP, len);
					PROTECT(nlbls);
					nbpointerprotected ++;
					for(int i = 0; i < len; i++)
						INTEGER(nlbls)[i] = INTEGER(lbls)[i] + bp;
					putInCode(putInPool(nlbls)); // Relocate using new labels
				}
				break;
		}
		args >>= BCPLEN;
		nb ++;
	}
	return nb;
}

static int validBC(int bc){
	return (bc >= 0) && (bc < 104);
}

static int isCodeBuffer(SEXP val){
	return ((TYPEOF(val) == VECSXP)
			&& (length(val) > 0));
			// && isBC(VECTOR_ELT(val, 0)));
}

static int isBC(SEXP c){
	return (TYPEOF(c) == BCODESXP);
}

static int putNamesInPool(SEXP val){
	SEXP names = getAttrib(val, R_NamesSymbol);
	if(names != R_NilValue)
		return putInPool(names);
	return -1;
}

#define copy_array(dst, src, len, fun)\
	do{\
		int __array_idx = len;\
		typeof(src) __src_ptr = src; \
		typeof(dst) __dst_ptr = dst; \
		while(__array_idx --)\
			*__dst_ptr++ = fun(*__src_ptr++);\
	} while(0)


#ifdef __CACHE_SUBSYSTEM
// Basic cache system (a bit inefficient)
#	define CHECK_CACHED_STRING(__x__) \
	for(int ci = 0; ci < pp_cache; ci++)\
		if((cpool_cache[ci] == __x__)\
		 || ((TYPEOF(cpool_cache[ci]) == SYMSXP) && type == CHARSXP && !strcmp(CHAR(PRINTNAME(cpool_cache[ci])), CHAR(__x__))) \
		 || ((TYPEOF(cpool_cache[ci]) == CHARSXP) && type == SYMSXP && !strcmp(CHAR(PRINTNAME(__x__)), CHAR(cpool_cache[ci]))) \
		 || ((TYPEOF(cpool_cache[ci]) == CHARSXP) && type == CHARSXP && !strcmp(CHAR(cpool_cache[ci]), CHAR(__x__))) \
				){ \
			UNPROTECT(1);\
			return ci;\
		} else

#	define CHECK_CACHED(__x__) \
	for(int ci = 0; ci < pp_cache; ci++)\
		 if((cpool_cache[ci] == __x__ ) ||\
				 ((TYPEOF(cpool_cache[ci]) == type) && (RIDENTICAL(cpool_cache[ci], __x__) == TRUE))){ \
			 UNPROTECT(1);\
			return ci;\
		 } else

#	define ADD_TO_CACHE(__x__) \
	do{\
		cpool_cache[pp_cache++] = __x__;\
	}while(0)
static int pp_cache;
static SEXP cpool_cache[MAX_CPOOL];  // The singleton Constant Pool SEXP cache (not really smart but faster)
#else
#	define CHECK_CACHED(__x__) do { } while(0)
#	define CHECK_CACHED_STRING(__x__) do { } while(0)
#	define ADD_TO_CACHE(__x__) do { } while(0)
#endif

int putInPoolVerbose(SEXP val){
	int p = putInPool(val);
	Rprintf("pool: %d\t", p);
	PrintValue(val);
	return p;
}
static int putInPool(SEXP val){
	int len;
	int names_pe;
	int type;
	const char *str_ptr = NULL;
	cpool_entry pe = {0, {0,0,0}};

	switch(type = TYPEOF(val)){
		case PROMSXP: // if it's a promise just force it ... 
			if(PRVALUE(val) == R_UnboundValue){
				int idx;
				PROTECT(val);
				val = Rf_eval(val, PRENV(val));
				UNPROTECT(1);
			}
			return putInPool(PRVALUE(val));
		case NILSXP:
			PROTECT(val);
			CHECK_CACHED(val);
			UNPROTECT(1);
			pe.type = CPOOL_NULL;
			break;
		case SYMSXP:
		case CHARSXP:
			PROTECT(val);
			CHECK_CACHED_STRING(val);
			UNPROTECT(1);
			if(type == SYMSXP){
				str_ptr = CHAR(PRINTNAME(val));
			} else{
				str_ptr = CHAR(val);
			}
			len = strlen(str_ptr);
			pe.type = CPOOL_STR;
			pe.data.pe_char.size = len;
			pe.data.pe_char.value = (char*)str_ptr;
			break;
		case LANGSXP: // Treat languages as char (i.e. we don't really want them)
			val = Rf_deparse1(val, 0, 65); // Don't ask me why 65
		case LGLSXP:
		case INTSXP:
		case REALSXP:
		case CPLXSXP:
		case STRSXP:
		case VECSXP:
			PROTECT(val);
			CHECK_CACHED(val);
			UNPROTECT(1);
			len = length(val);
			names_pe = putNamesInPool(val);	
			pe.data.pe_vector.names = names_pe;
			pe.data.pe_vector.size = len;
			switch(type){
				case LGLSXP:
					pe.type = CPOOL_LGLSXP;
					pe.data.pe_int.values = malloc(len*sizeof(int));
					copy_array(pe.data.pe_lgl.values, LOGICAL(val), len, );
					break;
				case REALSXP:
					pe.type = CPOOL_DBLSXP;
					pe.data.pe_int.values = malloc(len*sizeof(double));
					copy_array(pe.data.pe_real.values, REAL(val), len, );
					break;
				case CPLXSXP:
					pe.type = CPOOL_CPXSXP;
					pe.data.pe_int.values = malloc(len*sizeof(Rcomplex));
					copy_array(pe.data.pe_cplx.values, COMPLEX(val), len, );
					break;
				case INTSXP:
					pe.type = CPOOL_INTSXP;
					pe.data.pe_int.values = malloc(len*sizeof(int));
					copy_array(pe.data.pe_int.values, INTEGER(val), len, );
					break;
				case STRSXP:
				case VECSXP:
				case LANGSXP:
					pe.type = (type == VECSXP) ? CPOOL_VECSXP : CPOOL_STRSXP;
					pe.data.pe_int.values = malloc(len*sizeof(int));
					copy_array(pe.data.pe_vector.values, VECTOR_PTR(val), len, putInPool);
					break;
			}
			break;
		default:
			dumpCachePool();
			PrintValue(val);
			dumpMyBC(cs, getPC(), Rprintf);
			error("NYI type: %d", type);
	}
	PROTECT(val);
	nbpointerprotected ++;

	ADD_TO_CACHE(val);
	cpool[header.pp] = pe; 
	if(header.pp == MAX_CPOOL)
		error("Constant pool exceded: %d", MAX_CPOOL);
	return header.pp ++;
}

static void dumpCachePool(){
#ifdef __CACHE_SUBSYSTEM
	Rprintf("pool size: %d (cache %d)\n", header.pp, pp_cache);
	for(int i = 0; i < header.pp; i++){
		Rprintf("%.4x:%.2d: ", i, TYPEOF(cpool_cache[i]));
		PrintValue(cpool_cache[i]);
	}
#endif
}

static void dumpBCObj(SEXP code){
	SEXP c = CAR((code)),
		 p = CDR((code)),
		 e = TAG((code));
	Rprintf("CODE %u %u\n", TYPEOF(c), length(c));
	dumpCode(c);
	Rprintf("\nCONST %u %u\n", TYPEOF(p), length(p));
	PrintValue(p);
	Rprintf("\nTAG %u %u\n", TYPEOF(e), length(e));
	PrintValue(e);
}

static void dumpCode(SEXP code){
	Rprintf("BC Length: %d\n", length(code));
	for(int i = 0; i < length(code); i++){
		int e = INTEGER(code)[i];
		Rprintf("%.2x %.2x  %.2x %.2x   ", (e >> 24), ((e >> 16) & 0xFF), ((e >> 8) & 0xFF), (e & 0xFF));
		if((i%4)==3)
			Rprintf("\n");
	}
}

SEXP mkCodeFix(SEXP bytes, SEXP consts)
{
    SEXP ans;
    ans = CONS(bytes, consts);
    SET_TYPEOF(ans, BCODESXP);
    return ans;
}
